home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1993 December
/
PSL Monthly Shareware CD-ROM (December 1993).iso
/
prgmming
/
dos
/
pascal
/
ztfdd.exe
/
ZFDDTEST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-08-09
|
2KB
|
108 lines
program ztfddtest;
{ A simple demo of the ZTFDD unit.
Look at the TMainWin.Paint() method for the ZTFDD usage }
uses WObjects, WinTypes, WinProcs, Strings, Ztfdd;
type
{ Define a TApplication descendant }
TMyApp = object(TApplication)
procedure InitMainWindow; virtual;
end;
pMainWin = ^TMainWin;
TMainWin = object(TWindow)
tm : ttextmetric;
cxchar,cychar : integer;
constructor Init(AParent: PWindowsObject; Title: PChar);
procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
procedure SetUpWindow; virtual;
end;
constructor tmainwin.Init(AParent: PWindowsObject; Title: PChar);
begin
twindow.init(aparent, title);
end;
procedure tmainwin.SetUpWindow;
var
dc : hdc;
begin
dc := getdc(hwindow);
gettextmetrics(dc,tm);
cxchar := tm.tmAveCharWidth;
cychar := tm.tmheight + tm.tmexternalleading;
releasedc(hwindow,dc);
end;
procedure tmainwin.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
const
Drives : array[0..4] of pchar = (
'cannot determine',
'Does not exist',
'Removable',
'Fixed',
'Remote');
var
r : trect;
y, i, j : integer;
l : longint;
procedure ShowLine;
begin
textout(paintdc, 0, y, GetZ, strlen(getz));
inc(y,cychar);
end;
begin
y := 0;
getclientrect(hwindow,r);
write(zout, 'The client rectangle is',
r.left:4, r.top:4, r.right:4, r.bottom:4);
showline;
l := getcurrentposition(paintdc);
write(zout, 'CurrentPosition = ', loword(l), ' ', hiword(l));
showline;
write(zout, 'Milliseconds elapsed since system was booted: ', getcurrenttime);
showline;
write(zout, 'Maxavail = ', maxavail, ', and MemAvail = ', memavail);
showline;
write(zout, 'There are ', getnumtasks, ' tasks running.');
showline;
inc(y,cychar);
for i := 0 to (ord('Z')-ord('A')) do begin
j := getdrivetype(i);
if j > 1 then begin
write(zout, 'Drive ', char(i+ord('A')), ' is ', Drives[j]);
showline;
end;
end;
end;
{ Construct the THelloApp's MainWindow object }
procedure TMyApp.InitMainWindow;
begin
MainWindow := New(PMainwin, Init(nil, 'My Application'));
end;
{ Declare a variable of type THelloApp }
var
HelloApp: TMyApp;
{ Run the HelloApp }
begin
HelloApp.Init('MyApp');
HelloApp.Run;
HelloApp.Done;
end.